home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / gnu / emacs.lha / emacs-19.16 / src / bytecode.c < prev    next >
C/C++ Source or Header  |  1993-05-22  |  23KB  |  1,159 lines
  1. /* Execution of byte code produced by bytecomp.el.
  2.    Copyright (C) 1985, 1986, 1987, 1988, 1993 Free Software Foundation, Inc.
  3.  
  4. This file is part of GNU Emacs.
  5.  
  6. GNU Emacs is free software; you can redistribute it and/or modify
  7. it under the terms of the GNU General Public License as published by
  8. the Free Software Foundation; either version 2, or (at your option)
  9. any later version.
  10.  
  11. GNU Emacs is distributed in the hope that it will be useful,
  12. but WITHOUT ANY WARRANTY; without even the implied warranty of
  13. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14. GNU General Public License for more details.
  15.  
  16. You should have received a copy of the GNU General Public License
  17. along with GNU Emacs; see the file COPYING.  If not, write to
  18. the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  19.  
  20. hacked on by jwz@lucid.com 17-jun-91
  21.   o  added a compile-time switch to turn on simple sanity checking;
  22.   o  put back the obsolete byte-codes for error-detection;
  23.   o  added a new instruction, unbind_all, which I will use for 
  24.      tail-recursion elimination;
  25.   o  made temp_output_buffer_show be called with the right number
  26.      of args;
  27.   o  made the new bytecodes be called with args in the right order;
  28.   o  added metering support.
  29.  
  30. by Hallvard:
  31.   o  added relative jump instructions;
  32.   o  all conditionals now only do QUIT if they jump.
  33.  */
  34.  
  35. #include "config.h"
  36. #include "lisp.h"
  37. #include "buffer.h"
  38. #include "syntax.h"
  39.  
  40. /*
  41.  * define BYTE_CODE_SAFE to enable some minor sanity checking (useful for 
  42.  * debugging the byte compiler...)
  43.  *
  44.  * define BYTE_CODE_METER to enable generation of a byte-op usage histogram. 
  45.  */
  46. /* #define BYTE_CODE_SAFE */
  47. /* #define BYTE_CODE_METER */
  48.  
  49.  
  50. #ifdef BYTE_CODE_METER
  51.  
  52. Lisp_Object Vbyte_code_meter, Qbyte_code_meter;
  53. int byte_metering_on;
  54.  
  55. #define METER_2(code1, code2) \
  56.   XFASTINT (XVECTOR (XVECTOR (Vbyte_code_meter)->contents[(code1)]) \
  57.         ->contents[(code2)])
  58.  
  59. #define METER_1(code) METER_2 (0, (code))
  60.  
  61. #define METER_CODE(last_code, this_code)            \
  62. {                                \
  63.   if (byte_metering_on)                        \
  64.     {                                \
  65.       if (METER_1 (this_code) != ((1<<VALBITS)-1))        \
  66.         METER_1 (this_code)++;                    \
  67.       if (last_code                        \
  68.       && METER_2 (last_code, this_code) != ((1<<VALBITS)-1))\
  69.         METER_2 (last_code, this_code)++;            \
  70.     }                                \
  71. }
  72.  
  73. #else /* no BYTE_CODE_METER */
  74.  
  75. #define METER_CODE(last_code, this_code)
  76.  
  77. #endif /* no BYTE_CODE_METER */
  78.  
  79.  
  80. Lisp_Object Qbytecode;
  81.  
  82. /*  Byte codes: */
  83.  
  84. #define Bvarref 010
  85. #define Bvarset 020
  86. #define Bvarbind 030
  87. #define Bcall 040
  88. #define Bunbind 050
  89.  
  90. #define Bnth 070
  91. #define Bsymbolp 071
  92. #define Bconsp 072
  93. #define Bstringp 073
  94. #define Blistp 074
  95. #define Beq 075
  96. #define Bmemq 076
  97. #define Bnot 077
  98. #define Bcar 0100
  99. #define Bcdr 0101
  100. #define Bcons 0102
  101. #define Blist1 0103
  102. #define Blist2 0104
  103. #define Blist3 0105
  104. #define Blist4 0106
  105. #define Blength 0107
  106. #define Baref 0110
  107. #define Baset 0111
  108. #define Bsymbol_value 0112
  109. #define Bsymbol_function 0113
  110. #define Bset 0114
  111. #define Bfset 0115
  112. #define Bget 0116
  113. #define Bsubstring 0117
  114. #define Bconcat2 0120
  115. #define Bconcat3 0121
  116. #define Bconcat4 0122
  117. #define Bsub1 0123
  118. #define Badd1 0124
  119. #define Beqlsign 0125
  120. #define Bgtr 0126
  121. #define Blss 0127
  122. #define Bleq 0130
  123. #define Bgeq 0131
  124. #define Bdiff 0132
  125. #define Bnegate 0133
  126. #define Bplus 0134
  127. #define Bmax 0135
  128. #define Bmin 0136
  129. #define Bmult 0137
  130.  
  131. #define Bpoint 0140
  132. #define Bmark 0141 /* no longer generated as of v18 */
  133. #define Bgoto_char 0142
  134. #define Binsert 0143
  135. #define Bpoint_max 0144
  136. #define Bpoint_min 0145
  137. #define Bchar_after 0146
  138. #define Bfollowing_char 0147
  139. #define Bpreceding_char 0150
  140. #define Bcurrent_column 0151
  141. #define Bindent_to 0152
  142. #define Bscan_buffer 0153 /* No longer generated as of v18 */
  143. #define Beolp 0154
  144. #define Beobp 0155
  145. #define Bbolp 0156
  146. #define Bbobp 0157
  147. #define Bcurrent_buffer 0160
  148. #define Bset_buffer 0161
  149. #define Bread_char 0162 /* No longer generated as of v19 */
  150. #define Bset_mark 0163 /* this loser is no longer generated as of v18 */
  151. #define Binteractive_p 0164 /* Needed since interactive-p takes unevalled args */
  152.  
  153. #define Bforward_char 0165
  154. #define Bforward_word 0166
  155. #define Bskip_chars_forward 0167
  156. #define Bskip_chars_backward 0170
  157. #define Bforward_line 0171
  158. #define Bchar_syntax 0172
  159. #define Bbuffer_substring 0173
  160. #define Bdelete_region 0174
  161. #define Bnarrow_to_region 0175
  162. #define Bwiden 0176
  163. #define Bend_of_line 0177
  164.  
  165. #define Bconstant2 0201
  166. #define Bgoto 0202
  167. #define Bgotoifnil 0203
  168. #define Bgotoifnonnil 0204
  169. #define Bgotoifnilelsepop 0205
  170. #define Bgotoifnonnilelsepop 0206
  171. #define Breturn 0207
  172. #define Bdiscard 0210
  173. #define Bdup 0211
  174.  
  175. #define Bsave_excursion 0212
  176. #define Bsave_window_excursion 0213
  177. #define Bsave_restriction 0214
  178. #define Bcatch 0215
  179.  
  180. #define Bunwind_protect 0216
  181. #define Bcondition_case 0217
  182. #define Btemp_output_buffer_setup 0220
  183. #define Btemp_output_buffer_show 0221
  184.  
  185. #define Bunbind_all 0222
  186.  
  187. #define Bset_marker 0223
  188. #define Bmatch_beginning 0224
  189. #define Bmatch_end 0225
  190. #define Bupcase 0226
  191. #define Bdowncase 0227
  192.  
  193. #define Bstringeqlsign 0230
  194. #define Bstringlss 0231
  195. #define Bequal 0232
  196. #define Bnthcdr 0233
  197. #define Belt 0234
  198. #define Bmember 0235
  199. #define Bassq 0236
  200. #define Bnreverse 0237
  201. #define Bsetcar 0240
  202. #define Bsetcdr 0241
  203. #define Bcar_safe 0242
  204. #define Bcdr_safe 0243
  205. #define Bnconc 0244
  206. #define Bquo 0245
  207. #define Brem 0246
  208. #define Bnumberp 0247
  209. #define Bintegerp 0250
  210.  
  211. #define BRgoto 0252
  212. #define BRgotoifnil 0253
  213. #define BRgotoifnonnil 0254
  214. #define BRgotoifnilelsepop 0255
  215. #define BRgotoifnonnilelsepop 0256
  216.  
  217. #define BlistN 0257
  218. #define BconcatN 0260
  219. #define BinsertN 0261
  220.  
  221. #define Bconstant 0300
  222. #define CONSTANTLIM 0100
  223.  
  224. /* Fetch the next byte from the bytecode stream */
  225.  
  226. #define FETCH *pc++
  227.  
  228. /* Fetch two bytes from the bytecode stream
  229.  and make a 16-bit number out of them */
  230.  
  231. #define FETCH2 (op = FETCH, op + (FETCH << 8))
  232.  
  233. /* Push x onto the execution stack. */
  234.  
  235. /* This used to be #define PUSH(x) (*++stackp = (x))
  236.    This oddity is necessary because Alliant can't be bothered to
  237.    compile the preincrement operator properly, as of 4/91.  -JimB  */
  238. #define PUSH(x) (stackp++, *stackp = (x))
  239.  
  240. /* Pop a value off the execution stack.  */
  241.  
  242. #define POP (*stackp--)
  243.  
  244. /* Discard n values from the execution stack.  */
  245.  
  246. #define DISCARD(n) (stackp -= (n))
  247.  
  248. /* Get the value which is at the top of the execution stack, but don't pop it. */
  249.  
  250. #define TOP (*stackp)
  251.  
  252. DEFUN ("byte-code", Fbyte_code, Sbyte_code, 3, 3, 0,
  253.   "Function used internally in byte-compiled code.\n\
  254. The first argument is a string of byte code; the second, a vector of constants;\n\
  255. the third, the maximum stack depth used in this function.\n\
  256. If the third argument is incorrect, Emacs may crash.")
  257.   (bytestr, vector, maxdepth)
  258.      Lisp_Object bytestr, vector, maxdepth;
  259. {
  260.   struct gcpro gcpro1, gcpro2, gcpro3;
  261.   int count = specpdl_ptr - specpdl;
  262. #ifdef BYTE_CODE_METER
  263.   int this_op = 0;
  264.   int prev_op;
  265. #endif
  266.   register int op;
  267.   unsigned char *pc;
  268.   Lisp_Object *stack;
  269.   register Lisp_Object *stackp;
  270.   Lisp_Object *stacke;
  271.   register Lisp_Object v1, v2;
  272.   register Lisp_Object *vectorp = XVECTOR (vector)->contents;
  273. #ifdef BYTE_CODE_SAFE
  274.   register int const_length = XVECTOR (vector)->size;
  275. #endif
  276.   /* Copy of BYTESTR, saved so we can tell if BYTESTR was relocated.  */
  277.   Lisp_Object string_saved;
  278.   /* Cached address of beginning of string,
  279.      valid if BYTESTR equals STRING_SAVED.  */
  280.   register unsigned char *strbeg;
  281.  
  282.   CHECK_STRING (bytestr, 0);
  283.   if (XTYPE (vector) != Lisp_Vector)
  284.     vector = wrong_type_argument (Qvectorp, vector);
  285.   CHECK_NUMBER (maxdepth, 2);
  286.  
  287.   stackp = (Lisp_Object *) alloca (XFASTINT (maxdepth) * sizeof (Lisp_Object));
  288.   bzero (stackp, XFASTINT (maxdepth) * sizeof (Lisp_Object));
  289.   GCPRO3 (bytestr, vector, *stackp);
  290.   gcpro3.nvars = XFASTINT (maxdepth);
  291.  
  292.   --stackp;
  293.   stack = stackp;
  294.   stacke = stackp + XFASTINT (maxdepth);
  295.  
  296.   /* Initialize the saved pc-pointer for fetching from the string.  */
  297.   string_saved = bytestr;
  298.   pc = XSTRING (string_saved)->data;
  299.  
  300.   while (1)
  301.     {
  302. #ifdef BYTE_CODE_SAFE
  303.       if (stackp > stacke)
  304.     error ("Byte code stack overflow (byte compiler bug), pc %d, depth %d",
  305.            pc - XSTRING (string_saved)->data, stacke - stackp);
  306.       if (stackp < stack)
  307.     error ("Byte code stack underflow (byte compiler bug), pc %d",
  308.            pc - XSTRING (string_saved)->data);
  309. #endif
  310.  
  311.       if (! EQ (string_saved, bytestr))
  312.     {
  313.       pc = pc - XSTRING (string_saved)->data + XSTRING (bytestr)->data;
  314.       string_saved = bytestr;
  315.     }
  316.  
  317. #ifdef BYTE_CODE_METER
  318.       prev_op = this_op;
  319.       this_op = op = FETCH;
  320.       METER_CODE (prev_op, op);
  321.       switch (op)
  322. #else
  323.       switch (op = FETCH)
  324. #endif
  325.     {
  326.     case Bvarref+6:
  327.       op = FETCH;
  328.       goto varref;
  329.  
  330.     case Bvarref+7:
  331.       op = FETCH2;
  332.       goto varref;
  333.  
  334.     case Bvarref: case Bvarref+1: case Bvarref+2: case Bvarref+3:
  335.     case Bvarref+4: case Bvarref+5:
  336.       op = op - Bvarref;
  337.     varref:
  338.       v1 = vectorp[op];
  339.       if (XTYPE (v1) != Lisp_Symbol)
  340.         v2 = Fsymbol_value (v1);
  341.       else
  342.         {
  343.           v2 = XSYMBOL (v1)->value;
  344. #ifdef SWITCH_ENUM_BUG
  345.           switch ((int) XTYPE (v2))
  346. #else
  347.           switch (XTYPE (v2))
  348. #endif
  349.         {
  350.         case Lisp_Symbol:
  351.           if (!EQ (v2, Qunbound))
  352.             break;
  353.         case Lisp_Intfwd:
  354.         case Lisp_Boolfwd:
  355.         case Lisp_Objfwd:
  356.         case Lisp_Buffer_Local_Value:
  357.         case Lisp_Some_Buffer_Local_Value:
  358.         case Lisp_Buffer_Objfwd:
  359.         case Lisp_Void:
  360.           v2 = Fsymbol_value (v1);
  361.         }
  362.         }
  363.       PUSH (v2);
  364.       break;
  365.  
  366.     case Bvarset+6:
  367.       op = FETCH;
  368.       goto varset;
  369.  
  370.     case Bvarset+7:
  371.       op = FETCH2;
  372.       goto varset;
  373.  
  374.     case Bvarset: case Bvarset+1: case Bvarset+2: case Bvarset+3:
  375.     case Bvarset+4: case Bvarset+5:
  376.       op -= Bvarset;
  377.     varset:
  378.       Fset (vectorp[op], POP);
  379.       break;
  380.  
  381.     case Bvarbind+6:
  382.       op = FETCH;
  383.       goto varbind;
  384.  
  385.     case Bvarbind+7:
  386.       op = FETCH2;
  387.       goto varbind;
  388.  
  389.     case Bvarbind: case Bvarbind+1: case Bvarbind+2: case Bvarbind+3:
  390.     case Bvarbind+4: case Bvarbind+5:
  391.       op -= Bvarbind;
  392.     varbind:
  393.       specbind (vectorp[op], POP);
  394.       break;
  395.  
  396.     case Bcall+6:
  397.       op = FETCH;
  398.       goto docall;
  399.  
  400.     case Bcall+7:
  401.       op = FETCH2;
  402.       goto docall;
  403.  
  404.     case Bcall: case Bcall+1: case Bcall+2: case Bcall+3:
  405.     case Bcall+4: case Bcall+5:
  406.       op -= Bcall;
  407.     docall:
  408.       DISCARD (op);
  409. #ifdef BYTE_CODE_METER
  410.       if (byte_metering_on && XTYPE (TOP) == Lisp_Symbol)
  411.         {
  412.           v1 = TOP;
  413.           v2 = Fget (v1, Qbyte_code_meter);
  414.           if (XTYPE (v2) == Lisp_Int
  415.           && XINT (v2) != ((1<<VALBITS)-1))
  416.         {
  417.           XSETINT (v2, XINT (v2) + 1);
  418.           Fput (v1, Qbyte_code_meter, v2);
  419.         }
  420.         }
  421. #endif
  422.       TOP = Ffuncall (op + 1, &TOP);
  423.       break;
  424.  
  425.     case Bunbind+6:
  426.       op = FETCH;
  427.       goto dounbind;
  428.  
  429.     case Bunbind+7:
  430.       op = FETCH2;
  431.       goto dounbind;
  432.  
  433.     case Bunbind: case Bunbind+1: case Bunbind+2: case Bunbind+3:
  434.     case Bunbind+4: case Bunbind+5:
  435.       op -= Bunbind;
  436.     dounbind:
  437.       unbind_to (specpdl_ptr - specpdl - op, Qnil);
  438.       break;
  439.  
  440.     case Bunbind_all:
  441.       /* To unbind back to the beginning of this frame.  Not used yet,
  442.          but will be needed for tail-recursion elimination.  */
  443.       unbind_to (count, Qnil);
  444.       break;
  445.  
  446.     case Bgoto:
  447.       QUIT;
  448.       op = FETCH2;    /* pc = FETCH2 loses since FETCH2 contains pc++ */
  449.       pc = XSTRING (string_saved)->data + op;
  450.       break;
  451.  
  452.     case Bgotoifnil:
  453.       op = FETCH2;
  454.       if (NILP (POP))
  455.         {
  456.           QUIT;
  457.           pc = XSTRING (string_saved)->data + op;
  458.         }
  459.       break;
  460.  
  461.     case Bgotoifnonnil:
  462.       op = FETCH2;
  463.       if (!NILP (POP))
  464.         {
  465.           QUIT;
  466.           pc = XSTRING (string_saved)->data + op;
  467.         }
  468.       break;
  469.  
  470.     case Bgotoifnilelsepop:
  471.       op = FETCH2;
  472.       if (NILP (TOP))
  473.         {
  474.           QUIT;
  475.           pc = XSTRING (string_saved)->data + op;
  476.         }
  477.       else DISCARD (1);
  478.       break;
  479.  
  480.     case Bgotoifnonnilelsepop:
  481.       op = FETCH2;
  482.       if (!NILP (TOP))
  483.         {
  484.           QUIT;
  485.           pc = XSTRING (string_saved)->data + op;
  486.         }
  487.       else DISCARD (1);
  488.       break;
  489.  
  490.     case BRgoto:
  491.       QUIT;
  492.       pc += *pc - 127;
  493.       break;
  494.  
  495.     case BRgotoifnil:
  496.       if (NILP (POP))
  497.         {
  498.           QUIT;
  499.           pc += *pc - 128;
  500.         }
  501.       pc++;
  502.       break;
  503.  
  504.     case BRgotoifnonnil:
  505.       if (!NILP (POP))
  506.         {
  507.           QUIT;
  508.           pc += *pc - 128;
  509.         }
  510.       pc++;
  511.       break;
  512.  
  513.     case BRgotoifnilelsepop:
  514.       op = *pc++;
  515.       if (NILP (TOP))
  516.         {
  517.           QUIT;
  518.           pc += op - 128;
  519.         }
  520.       else DISCARD (1);
  521.       break;
  522.  
  523.     case BRgotoifnonnilelsepop:
  524.       op = *pc++;
  525.       if (!NILP (TOP))
  526.         {
  527.           QUIT;
  528.           pc += op - 128;
  529.         }
  530.       else DISCARD (1);
  531.       break;
  532.  
  533.     case Breturn:
  534.       v1 = POP;
  535.       goto exit;
  536.  
  537.     case Bdiscard:
  538.       DISCARD (1);
  539.       break;
  540.  
  541.     case Bdup:
  542.       v1 = TOP;
  543.       PUSH (v1);
  544.       break;
  545.  
  546.     case Bconstant2:
  547.       PUSH (vectorp[FETCH2]);
  548.       break;
  549.  
  550.     case Bsave_excursion:
  551.       record_unwind_protect (save_excursion_restore, save_excursion_save ());
  552.       break;
  553.  
  554.     case Bsave_window_excursion:
  555.       TOP = Fsave_window_excursion (TOP);
  556.       break;
  557.  
  558.     case Bsave_restriction:
  559.       record_unwind_protect (save_restriction_restore, save_restriction_save ());
  560.       break;
  561.  
  562.     case Bcatch:
  563.       v1 = POP;
  564.       TOP = internal_catch (TOP, Feval, v1);
  565.       break;
  566.  
  567.     case Bunwind_protect:
  568.       record_unwind_protect (0, POP);
  569.       (specpdl_ptr - 1)->symbol = Qnil;
  570.       break;
  571.  
  572.     case Bcondition_case:
  573.       v1 = POP;
  574.       v1 = Fcons (POP, v1);
  575.       TOP = Fcondition_case (Fcons (TOP, v1));
  576.       break;
  577.  
  578.     case Btemp_output_buffer_setup:
  579.       temp_output_buffer_setup (XSTRING (TOP)->data);
  580.       TOP = Vstandard_output;
  581.       break;
  582.  
  583.     case Btemp_output_buffer_show:
  584.       v1 = POP;
  585.       temp_output_buffer_show (TOP);
  586.       TOP = v1;
  587.       /* pop binding of standard-output */
  588.       unbind_to (specpdl_ptr - specpdl - 1, Qnil);
  589.       break;
  590.  
  591.     case Bnth:
  592.       v1 = POP;
  593.       v2 = TOP;
  594.     nth_entry:
  595.       CHECK_NUMBER (v2, 0);
  596.       op = XINT (v2);
  597.       immediate_quit = 1;
  598.       while (--op >= 0)
  599.         {
  600.           if (CONSP (v1))
  601.         v1 = XCONS (v1)->cdr;
  602.           else if (!NILP (v1))
  603.         {
  604.           immediate_quit = 0;
  605.           v1 = wrong_type_argument (Qlistp, v1);
  606.           immediate_quit = 1;
  607.           op++;
  608.         }
  609.         }
  610.       immediate_quit = 0;
  611.       goto docar;
  612.  
  613.     case Bsymbolp:
  614.       TOP = XTYPE (TOP) == Lisp_Symbol ? Qt : Qnil;
  615.       break;
  616.  
  617.     case Bconsp:
  618.       TOP = CONSP (TOP) ? Qt : Qnil;
  619.       break;
  620.  
  621.     case Bstringp:
  622.       TOP = XTYPE (TOP) == Lisp_String ? Qt : Qnil;
  623.       break;
  624.  
  625.     case Blistp:
  626.       TOP = CONSP (TOP) || NILP (TOP) ? Qt : Qnil;
  627.       break;
  628.  
  629.     case Beq:
  630.       v1 = POP;
  631.       TOP = EQ (v1, TOP) ? Qt : Qnil;
  632.       break;
  633.  
  634.     case Bmemq:
  635.       v1 = POP;
  636.       TOP = Fmemq (TOP, v1);
  637.       break;
  638.  
  639.     case Bnot:
  640.       TOP = NILP (TOP) ? Qt : Qnil;
  641.       break;
  642.  
  643.     case Bcar:
  644.       v1 = TOP;
  645.     docar:
  646.       if (CONSP (v1)) TOP = XCONS (v1)->car;
  647.       else if (NILP (v1)) TOP = Qnil;
  648.       else Fcar (wrong_type_argument (Qlistp, v1));
  649.       break;
  650.  
  651.     case Bcdr:
  652.       v1 = TOP;
  653.       if (CONSP (v1)) TOP = XCONS (v1)->cdr;
  654.       else if (NILP (v1)) TOP = Qnil;
  655.       else Fcdr (wrong_type_argument (Qlistp, v1));
  656.       break;
  657.  
  658.     case Bcons:
  659.       v1 = POP;
  660.       TOP = Fcons (TOP, v1);
  661.       break;
  662.  
  663.     case Blist1:
  664.       TOP = Fcons (TOP, Qnil);
  665.       break;
  666.  
  667.     case Blist2:
  668.       v1 = POP;
  669.       TOP = Fcons (TOP, Fcons (v1, Qnil));
  670.       break;
  671.  
  672.     case Blist3:
  673.       DISCARD (2);
  674.       TOP = Flist (3, &TOP);
  675.       break;
  676.  
  677.     case Blist4:
  678.       DISCARD (3);
  679.       TOP = Flist (4, &TOP);
  680.       break;
  681.  
  682.     case BlistN:
  683.       op = FETCH;
  684.       DISCARD (op - 1);
  685.       TOP = Flist (op, &TOP);
  686.       break;
  687.  
  688.     case Blength:
  689.       TOP = Flength (TOP);
  690.       break;
  691.  
  692.     case Baref:
  693.           v1 = POP;
  694.       TOP = Faref (TOP, v1);
  695.       break;
  696.  
  697.     case Baset:
  698.       v2 = POP; v1 = POP;
  699.       TOP = Faset (TOP, v1, v2);
  700.       break;
  701.  
  702.     case Bsymbol_value:
  703.       TOP = Fsymbol_value (TOP);
  704.       break;
  705.  
  706.     case Bsymbol_function:
  707.       TOP = Fsymbol_function (TOP);
  708.       break;
  709.  
  710.     case Bset:
  711.       v1 = POP;
  712.       TOP = Fset (TOP, v1);
  713.       break;
  714.  
  715.     case Bfset:
  716.       v1 = POP;
  717.       TOP = Ffset (TOP, v1);
  718.       break;
  719.  
  720.     case Bget:
  721.       v1 = POP;
  722.       TOP = Fget (TOP, v1);
  723.       break;
  724.  
  725.     case Bsubstring:
  726.       v2 = POP; v1 = POP;
  727.       TOP = Fsubstring (TOP, v1, v2);
  728.       break;
  729.  
  730.     case Bconcat2:
  731.       DISCARD (1);
  732.       TOP = Fconcat (2, &TOP);
  733.       break;
  734.  
  735.     case Bconcat3:
  736.       DISCARD (2);
  737.       TOP = Fconcat (3, &TOP);
  738.       break;
  739.  
  740.     case Bconcat4:
  741.       DISCARD (3);
  742.       TOP = Fconcat (4, &TOP);
  743.       break;
  744.  
  745.     case BconcatN:
  746.       op = FETCH;
  747.       DISCARD (op - 1);
  748.       TOP = Fconcat (op, &TOP);
  749.       break;
  750.  
  751.     case Bsub1:
  752.       v1 = TOP;
  753.       if (XTYPE (v1) == Lisp_Int)
  754.         {
  755.           XSETINT (v1, XINT (v1) - 1);
  756.           TOP = v1;
  757.         }
  758.       else
  759.         TOP = Fsub1 (v1);
  760.       break;
  761.  
  762.     case Badd1:
  763.       v1 = TOP;
  764.       if (XTYPE (v1) == Lisp_Int)
  765.         {
  766.           XSETINT (v1, XINT (v1) + 1);
  767.           TOP = v1;
  768.         }
  769.       else
  770.         TOP = Fadd1 (v1);
  771.       break;
  772.  
  773.     case Beqlsign:
  774.       v2 = POP; v1 = TOP;
  775.       CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (v1, 0);
  776.       CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (v2, 0);
  777.       TOP = (XFLOATINT (v1) == XFLOATINT (v2)) ? Qt : Qnil;
  778.       break;
  779.  
  780.     case Bgtr:
  781.       v1 = POP;
  782.       TOP = Fgtr (TOP, v1);
  783.       break;
  784.  
  785.     case Blss:
  786.       v1 = POP;
  787.       TOP = Flss (TOP, v1);
  788.       break;
  789.  
  790.     case Bleq:
  791.       v1 = POP;
  792.       TOP = Fleq (TOP, v1);
  793.       break;
  794.  
  795.     case Bgeq:
  796.       v1 = POP;
  797.       TOP = Fgeq (TOP, v1);
  798.       break;
  799.  
  800.     case Bdiff:
  801.       DISCARD (1);
  802.       TOP = Fminus (2, &TOP);
  803.       break;
  804.  
  805.     case Bnegate:
  806.       v1 = TOP;
  807.       if (XTYPE (v1) == Lisp_Int)
  808.         {
  809.           XSETINT (v1, - XINT (v1));
  810.           TOP = v1;
  811.         }
  812.       else
  813.         TOP = Fminus (1, &TOP);
  814.       break;
  815.  
  816.     case Bplus:
  817.       DISCARD (1);
  818.       TOP = Fplus (2, &TOP);
  819.       break;
  820.  
  821.     case Bmax:
  822.       DISCARD (1);
  823.       TOP = Fmax (2, &TOP);
  824.       break;
  825.  
  826.     case Bmin:
  827.       DISCARD (1);
  828.       TOP = Fmin (2, &TOP);
  829.       break;
  830.  
  831.     case Bmult:
  832.       DISCARD (1);
  833.       TOP = Ftimes (2, &TOP);
  834.       break;
  835.  
  836.     case Bquo:
  837.       DISCARD (1);
  838.       TOP = Fquo (2, &TOP);
  839.       break;
  840.  
  841.     case Brem:
  842.       v1 = POP;
  843.       TOP = Frem (TOP, v1);
  844.       break;
  845.  
  846.     case Bpoint:
  847.       XFASTINT (v1) = point;
  848.       PUSH (v1);
  849.       break;
  850.  
  851.     case Bgoto_char:
  852.       TOP = Fgoto_char (TOP);
  853.       break;
  854.  
  855.     case Binsert:
  856.       TOP = Finsert (1, &TOP);
  857.       break;
  858.  
  859.     case BinsertN:
  860.       op = FETCH;
  861.       DISCARD (op - 1);
  862.       TOP = Finsert (op, &TOP);
  863.       break;
  864.  
  865.     case Bpoint_max:
  866.       XFASTINT (v1) = ZV;
  867.       PUSH (v1);
  868.       break;
  869.  
  870.     case Bpoint_min:
  871.       XFASTINT (v1) = BEGV;
  872.       PUSH (v1);
  873.       break;
  874.  
  875.     case Bchar_after:
  876.       TOP = Fchar_after (TOP);
  877.       break;
  878.  
  879.     case Bfollowing_char:
  880.       XFASTINT (v1) = PT == ZV ? 0 : FETCH_CHAR (point);
  881.       PUSH (v1);
  882.       break;
  883.  
  884.     case Bpreceding_char:
  885.       XFASTINT (v1) = point <= BEGV ? 0 : FETCH_CHAR (point - 1);
  886.       PUSH (v1);
  887.       break;
  888.  
  889.     case Bcurrent_column:
  890.       XFASTINT (v1) = current_column ();
  891.       PUSH (v1);
  892.       break;
  893.  
  894.     case Bindent_to:
  895.       TOP = Findent_to (TOP, Qnil);
  896.       break;
  897.  
  898.     case Beolp:
  899.       PUSH (Feolp ());
  900.       break;
  901.  
  902.     case Beobp:
  903.       PUSH (Feobp ());
  904.       break;
  905.  
  906.     case Bbolp:
  907.       PUSH (Fbolp ());
  908.       break;
  909.  
  910.     case Bbobp:
  911.       PUSH (Fbobp ());
  912.       break;
  913.  
  914.     case Bcurrent_buffer:
  915.       PUSH (Fcurrent_buffer ());
  916.       break;
  917.  
  918.     case Bset_buffer:
  919.       TOP = Fset_buffer (TOP);
  920.       break;
  921.  
  922.     case Bread_char:
  923.       PUSH (Fread_char ());
  924.       QUIT;
  925.       break;
  926.  
  927.     case Binteractive_p:
  928.       PUSH (Finteractive_p ());
  929.       break;
  930.  
  931.     case Bforward_char:
  932.       TOP = Fforward_char (TOP);
  933.       break;
  934.  
  935.     case Bforward_word:
  936.       TOP = Fforward_word (TOP);
  937.       break;
  938.  
  939.     case Bskip_chars_forward:
  940.       v1 = POP;
  941.       TOP = Fskip_chars_forward (TOP, v1);
  942.       break;
  943.  
  944.     case Bskip_chars_backward:
  945.       v1 = POP;
  946.       TOP = Fskip_chars_backward (TOP, v1);
  947.       break;
  948.  
  949.     case Bforward_line:
  950.       TOP = Fforward_line (TOP);
  951.       break;
  952.  
  953.     case Bchar_syntax:
  954.       CHECK_NUMBER (TOP, 0);
  955.       XFASTINT (TOP) = syntax_code_spec[(int) SYNTAX (0xFF & XINT (TOP))];
  956.       break;
  957.  
  958.     case Bbuffer_substring:
  959.       v1 = POP;
  960.       TOP = Fbuffer_substring (TOP, v1);
  961.       break;
  962.  
  963.     case Bdelete_region:
  964.       v1 = POP;
  965.       TOP = Fdelete_region (TOP, v1);
  966.       break;
  967.  
  968.     case Bnarrow_to_region:
  969.       v1 = POP;
  970.       TOP = Fnarrow_to_region (TOP, v1);
  971.       break;
  972.  
  973.     case Bwiden:
  974.       PUSH (Fwiden ());
  975.       break;
  976.  
  977.     case Bend_of_line:
  978.       TOP = Fend_of_line (TOP);
  979.       break;
  980.  
  981.     case Bset_marker:
  982.       v1 = POP;
  983.       v2 = POP;
  984.       TOP = Fset_marker (TOP, v2, v1);
  985.       break;
  986.  
  987.     case Bmatch_beginning:
  988.       TOP = Fmatch_beginning (TOP);
  989.       break;
  990.  
  991.     case Bmatch_end:
  992.       TOP = Fmatch_end (TOP);
  993.       break;
  994.  
  995.     case Bupcase:
  996.       TOP = Fupcase (TOP);
  997.       break;
  998.  
  999.     case Bdowncase:
  1000.       TOP = Fdowncase (TOP);
  1001.     break;
  1002.  
  1003.     case Bstringeqlsign:
  1004.       v1 = POP;
  1005.       TOP = Fstring_equal (TOP, v1);
  1006.       break;
  1007.  
  1008.     case Bstringlss:
  1009.       v1 = POP;
  1010.       TOP = Fstring_lessp (TOP, v1);
  1011.       break;
  1012.  
  1013.     case Bequal:
  1014.       v1 = POP;
  1015.       TOP = Fequal (TOP, v1);
  1016.       break;
  1017.  
  1018.     case Bnthcdr:
  1019.       v1 = POP;
  1020.       TOP = Fnthcdr (TOP, v1);
  1021.       break;
  1022.  
  1023.     case Belt:
  1024.       if (XTYPE (TOP) == Lisp_Cons)
  1025.         {
  1026.           /* Exchange args and then do nth.  */
  1027.           v2 = POP;
  1028.           v1 = TOP;
  1029.           goto nth_entry;
  1030.         }
  1031.       v1 = POP;
  1032.       TOP = Felt (TOP, v1);
  1033.       break;
  1034.  
  1035.     case Bmember:
  1036.       v1 = POP;
  1037.       TOP = Fmember (TOP, v1);
  1038.       break;
  1039.  
  1040.     case Bassq:
  1041.       v1 = POP;
  1042.       TOP = Fassq (TOP, v1);
  1043.       break;
  1044.  
  1045.     case Bnreverse:
  1046.       TOP = Fnreverse (TOP);
  1047.       break;
  1048.  
  1049.     case Bsetcar:
  1050.       v1 = POP;
  1051.       TOP = Fsetcar (TOP, v1);
  1052.       break;
  1053.  
  1054.     case Bsetcdr:
  1055.       v1 = POP;
  1056.       TOP = Fsetcdr (TOP, v1);
  1057.       break;
  1058.  
  1059.     case Bcar_safe:
  1060.       v1 = TOP;
  1061.       if (XTYPE (v1) == Lisp_Cons)
  1062.         TOP = XCONS (v1)->car;
  1063.       else
  1064.         TOP = Qnil;
  1065.       break;
  1066.  
  1067.     case Bcdr_safe:
  1068.       v1 = TOP;
  1069.       if (XTYPE (v1) == Lisp_Cons)
  1070.         TOP = XCONS (v1)->cdr;
  1071.       else
  1072.         TOP = Qnil;
  1073.       break;
  1074.  
  1075.     case Bnconc:
  1076.       DISCARD (1);
  1077.       TOP = Fnconc (2, &TOP);
  1078.       break;
  1079.  
  1080.     case Bnumberp:
  1081.       TOP = (NUMBERP (TOP) ? Qt : Qnil);
  1082.       break;
  1083.  
  1084.     case Bintegerp:
  1085.       TOP = XTYPE (TOP) == Lisp_Int ? Qt : Qnil;
  1086.       break;
  1087.  
  1088. #ifdef BYTE_CODE_SAFE
  1089.     case Bset_mark:
  1090.       error ("set-mark is an obsolete bytecode");
  1091.       break;
  1092.     case Bscan_buffer:
  1093.       error ("scan-buffer is an obsolete bytecode");
  1094.       break;
  1095.     case Bmark:
  1096.       error ("mark is an obsolete bytecode");
  1097.       break;
  1098. #endif
  1099.  
  1100.     default:
  1101. #ifdef BYTE_CODE_SAFE
  1102.       if (op < Bconstant)
  1103.         error ("unknown bytecode %d (byte compiler bug)", op);
  1104.       if ((op -= Bconstant) >= const_length)
  1105.         error ("no constant number %d (byte compiler bug)", op);
  1106.       PUSH (vectorp[op]);
  1107. #else
  1108.       PUSH (vectorp[op - Bconstant]);
  1109. #endif
  1110.     }
  1111.     }
  1112.  
  1113.  exit:
  1114.   UNGCPRO;
  1115.   /* Binds and unbinds are supposed to be compiled balanced.  */
  1116.   if (specpdl_ptr - specpdl != count)
  1117. #ifdef BYTE_CODE_SAFE
  1118.     error ("binding stack not balanced (serious byte compiler bug)");
  1119. #else
  1120.     abort ();
  1121. #endif
  1122.   return v1;
  1123. }
  1124.  
  1125. syms_of_bytecode ()
  1126. {
  1127.   Qbytecode = intern ("byte-code");
  1128.   staticpro (&Qbytecode);
  1129.  
  1130.   defsubr (&Sbyte_code);
  1131.  
  1132. #ifdef BYTE_CODE_METER
  1133.  
  1134.   DEFVAR_LISP ("byte-code-meter", &Vbyte_code_meter,
  1135.    "A vector of vectors which holds a histogram of byte-code usage.\n\
  1136. (aref (aref byte-code-meter 0) CODE) indicates how many times the byte\n\
  1137. opcode CODE has been executed.\n\
  1138. (aref (aref byte-code-meter CODE1) CODE2), where CODE1 is not 0,\n\
  1139. indicates how many times the byte opcodes CODE1 and CODE2 have been\n\
  1140. executed in succession.");
  1141.   DEFVAR_BOOL ("byte-metering-on", &byte_metering_on,
  1142.    "If non-nil, keep profiling information on byte code usage.\n\
  1143. The variable byte-code-meter indicates how often each byte opcode is used.\n\
  1144. If a symbol has a property named `byte-code-meter' whose value is an\n\
  1145. integer, it is incremented each time that symbol's function is called.");
  1146.  
  1147.   byte_metering_on = 0;
  1148.   Vbyte_code_meter = Fmake_vector (make_number (256), make_number (0));
  1149.   Qbyte_code_meter = intern ("byte-code-meter");
  1150.   staticpro (&Qbyte_code_meter);
  1151.   {
  1152.     int i = 256;
  1153.     while (i--)
  1154.       XVECTOR (Vbyte_code_meter)->contents[i] =
  1155.     Fmake_vector (make_number (256), make_number (0));
  1156.   }
  1157. #endif
  1158. }
  1159.